;<134-TENEX>FREE.MAC;2 4-Nov-76 06:47:13 EDIT BY LYNCH ; FIXED LONG STANDING BUG IN ASGJFR ;<134-TENEX>FREE.MAC;39 28-APR-75 12:14:22 EDIT BY CLEMENTS ;<134-TENEX>FREE.MAC;38 28-APR-75 11:32:15 EDIT BY CLEMENTS ;<134-TENEX>FREE.MAC;37 24-APR-75 14:15:03 EDIT BY CLEMENTS ;FREE.REL;36 13-FEB-73 18:57:03 EDIT BY CLEMENTS ; ADDED JBCLCK IN ASGPAG ;FREE.MAC;35 21-NOV-72 7:26:46 EDIT BY WALLACE ;FREE.MAC;34 21-NOV-72 7:14:26 EDIT BY WALLACE ;FREE.MAC;33 28-SEP-72 14:51:38 EDIT BY TOMLINSON ;FREE.MAC;32 28-SEP-72 14:20:45 EDIT BY TOMLINSON ; Relfre returns biggest block found if failure ;FREE.MAC;31 29-JUN-72 9:56:22 EDIT BY TOMLINSON SEARCH MONSYM,MACSYM SEARCH STENEX,PROLOG TITLE FREE ; Storage routines SUBTTL R.s.tomlinson EXTERN BHC EXTERN HSHLUK,MAPDIR,RESAC,SAVAC,SKPRET,USTDIR,XPAND0 EXTERN BUGCHK,BUGHLT,MSTKOV USE SWAPPC ; Assign space in free storage region ; Call: RH(A) ; Location of free storage header ; LH(A) ; Index field for references to a and pointers ; ; I.e. @a references first word of header ; B ; Size of block needed ; PUSHJ P,ASGFRE ; Return ; +1 ; Not enough space ; +2 ; Ok, in a, the location of the block (absolute) ; Clobbers a,b,c,d ; Calling routine must take measures to prevent loss of free storage ; Space by inhibiting psi's until the space assigned ; Has been accounted for ; Free storage header format is: ; 0 ; Lh points to first free block ; 1 ; Lock ; 2 ; Space counter ; 3 ; Most common block size ; 4 ; Lh has max top of free storage ; Rh has min bottom ; 5 ; Temp 2 ; 6 ; Temp 3 ASGFRE::MOVEI C,@A ; Get origin of header CAMLE B,2(C) ; Any possibility of success? POPJ P, ; No. return immediately LOCK 1(C) ; Lock this free storage list PUSH P,B ; Save desired block size PUSH P,[0] ; BIGEST BLOCK SEEN SO FAR MOVEI B,377777 MOVEM B,5(C) ; Initial best block size SETZM 6(C) ; Initial location of best block MOVE B,A ; Start with the header word HLLZ C,A ; Initialize index field MOVEI A,@A ASGFR1: HLR C,@B ; Get pointer to next block TRNN C,777777 JRST ASGFR2 ; No more free blocks to examine HRRZ D,@C ; Get size of the block CAMLE D,0(P) MOVEM D,0(P) CAMN D,-1(P) ; Is it the right size? JRST ASGFR3 ; Just right use it CAML D,-1(P) ; Too small CAML D,5(A) ; Or bigger than best? JRST ASGFR4 ; Yes, ignore it MOVEM D,5(A) ; This one is better MOVEM B,6(A) ASGFR4: MOVE B,C ; Step to next block JRST ASGFR1 ; And repeat ASGFR2: SKIPN B,6(A) ; Did we find anything? JRST [ UNLOCK 1(A) ; No. unlock and return POP P,B ; Make transparent to b on error POP P,B ; REALLY RESTORE B! POPJ P,] MOVE D,-1(P) ; Get desired size HLR C,@B ; Get pointer to block to be used HRRM D,@C ; Convert to desired size ADD D,C ; Pointer remainder of block HRLM D,@B ; Point prev to remainder HLLZ B,@C ; Get next HLLM B,@D ; Point remainder to it MOVE B,5(A) SUB B,-1(P) ; Size of remainder HRRM B,@D ; To header of remainder ASGFR5: SUB P,BHC+1 MOVN B,0(P) ADDM B,2(A) ; Reduce count of space left UNLOCK 1(A) MOVEI A,@C ; Get origin of block HRROS (A) ; Set lh to ones HRRZ B,(A) ; Get rh HRRZI C,2(A) HRLI C,1(A) ADD B,A HRRZS B SETZM -1(C) CAIGE B,(C) BLT C,-1(B) ; Zero the block POP P,B AOS (P) POPJ P, ASGFR3: HLL D,@C HLLM D,@B ; Point predecessor to successor JRST ASGFR5 ; Release free storage block ; Call: A ; Location of free storage header (like asgfre) ; B ; Location of the block to be returned ; PUSHJ P,RELFRE ; Clobbers b,c,d RELFRE::HLLZ C,A SUBI B,@C HLL B,A PUSH P,A MOVEI A,@A LOCK 1(A) HRRZ D,0(A) JUMPE D,RELFR0 ; Jump if old style free block HLRZ D,4(A) HRRZ A,4(A) CAILE D,0(B) CAILE A,0(B) JRST RELFRA MOVEI A,@0(P) JRST RELFR0 RELFRA: BUG(CHK,) MOVEI A,@0(P) UNLOCK 1(A) POP P,A POPJ P, RELFR0: PUSH P,B MOVE B,-1(P) RELFR1: HLR C,@B ; Get loc of next block TRNN C,777777 JRST RELFR2 ; End of list CAML C,0(P) JRST RELFR2 ; Or above block being returned MOVE B,C JRST RELFR1 RELFR2: CAME C,0(P) ; Releasing a block already released? JRST RELFRB UNLOCK(<1(A)>) BUG(CHK,) POP P,B POP P,A POPJ P, RELFRB: HRRZ D,@0(P) ADDM D,2(A) ; Augment count of remaining storage ADD D,0(P) ; Get end of block being returned CAME D,C ; Same as following block location? JRST RELFR3 ; No HRRZ D,@C ; Get length of following block ADDM D,@0(P) ; Augment length of block being returned HLLZ D,@C ; Get loc of successor of successor HLLM D,@0(P) RELFR5: MOVE C,0(P) HRLM C,@B HRRZ D,@B ; Length of predecessor ADD D,B ; End of predecessor CAME D,C ; Same as new block JRST RELFR4 ; No, done MOVE C,@C HLLM C,@B HRRZS C ADDM C,@B RELFR4: UNLOCK 1(A) POP P,B POP P,A POPJ P, RELFR3: HRLM C,@0(P) ; Point returned block to successor JRST RELFR5 ; Assign a page in job area ; Call: PUSHJ P,ASGPAG ; Return ; +1 ; None available ; +2 ; Success ; A ; Address of origin of page ASGPAG::LOCK(JBCLCK) ;LOCK THE PAGE ASSIGNMENT MOVSI C,-4 ; Four words of bits ASGPG1: MOVE A,JBCOR(C) JFFO A,ASGPG2 ; Any bits? AOBJN C,ASGPG1 ; No, try next word UNLOCK(JBCLCK) POPJ P, ; No words left ASGPG2: MOVN B,A+1 MOVSI A,400000 ROT A,(B) ANDCAM A,JBCOR(C) ; Mark as used UNLOCK(JBCLCK) MOVEI A,(C) IMULI A,^D36 SUB A,B LSH A,9 ADDI A,PJMA ; Origin of job mapped area JRST SKPRET ; Return page ; Call: A ; Location of page ; PUSHJ P,RELPAG RELPAG::SUBI A,PJMA LSH A,-9 IDIVI A,^D36 MOVSI C,400000 MOVNS A+1 ROT C,(A+1) IORM C,JBCOR(A) ; Clear the bit POPJ P, ; Assign free storage in directory ; Call: B ; Size of block needed ; PUSHJ P,ASGDFR ; Return ; +1 ; Not enough room ; +2 ; Ok, in a, the location of the block ; Clobbers a,b,c,d ASGDFR::MOVE A,[XWD E,DIRFRE-DIRORG] PUSH P,E MOVEI E,DIRORG PUSHJ P,ASGFRE JRST ASGDF1 ; No room, try garbage collection ASGDF3: AOS -1(P) ASGDF2: POP P,E POPJ P, ASGDF1: PUSHJ P,GCDIR MOVE A,[XWD E,DIRFRE-DIRORG] PUSHJ P,ASGFRE JRST ASGDF4 ; Still no room JRST ASGDF3 ; Now ok ASGDF4: MOVE A,FRETOP SUB A,DIRFRE+2 ADDI A,2(B) ; Where fretop must be if moved up + PUSH P,B ; Save b CAMG A,SYMBOT ; Will this overlap symtab? JRST ASGDF5 ; No PUSHJ P,XPAND0 ; Move symtab up JRST [ POP P,B JRST ASGDF2] ; Fail SKIPA A,[-10] ; Space to leave for symtab after xpand ASGDF5: MOVNI A,2 ; Space to leave if no xpand ADD A,SYMBOT ; Target fretop MOVE B,FRETOP HRLM A,DIRFRE+4 MOVEM A,FRETOP ; New fretop SUB A,B ; Length of additional storage MOVEM A,DIRORG(B) ; Make block header MOVEI B,DIRORG(B) ; Convert to absolute PUSHJ P,RELDFR ; Let reldfr put back the storage POP P,B MOVE A,[XWD E,DIRFRE-DIRORG] PUSHJ P,ASGFRE JRST ASGDF2 JRST ASGDF3 ; Release free storage in directory ; Call: B ; Location of the block to be released ; PUSHJ P,RELDFR ; Returns +1 always ; Clobbers a,b,c,d RELDFR::MOVE A,[XWD E,DIRFRE-DIRORG] PUSH P,E MOVEI E,DIRORG PUSHJ P,RELFRE POP P,E POPJ P, ; Assign job storage ; Call: B ; Size of block needed ; PUSHJ P,ASGJFR ; Return ; +1 ; Not enough room ; +2 ; Success. location of block in b ASGJFR::MOVEI A,JSBFRE PUSHJ P,ASGFRE ; Attempt to assign JRST ASGJF1 ; Not enough AOS (P) ; Success POPJ P, ASGJF1: PUSH P,B PUSH P,C PUSHJ P,ASGPAG ; Get another page of job storage JRST ASGJF2 ; No pages left MOVEI B,1000 HRROM B,(A) ; Make a free block out of it MOVEI B,1000(A) HLRZ C,4+JSBFRE CAMGE C,B HRLM B,4+JSBFRE MOVE B,A MOVEI A,JSBFRE PUSHJ P,RELFRE ; Release the new block POP P,C POP P,B JRST ASGJFR ; Try again ASGJF2: POP P,C POP P,B POPJ P, ; Fail ; Garbage collect a directory ; Call: PUSHJ P,GCDIR ; Transparent EXTERN BITS GCDIR:: PUSHJ P,SAVAC ; Sav ac's ADD P,[XWD 5,5] ; Make room for temps on stack JUMPGE P,MSTKOV PUSHJ P,ASGPAG ; Get a page for bit table BUG(HLT,) HRLI A,A ; Index by a MOVEM A,0(P) ; Used to reference bit table HRLZ B,A HRRI B,1(A) ; Prepare blt pointer SETZM 0(A) BLT B,777(A) ; And zero page JSP D,GCSCAN ; Initialize scanner GCDI0: JSP D,0(D) ; Co-routine jump JRST GCDI2 ; No more JRST GCDI0 ; Pointer only CAMGE E,FRETOP CAIGE E,DIFREE-DIRORG JRST GCDI0 ; Not pointer to dynamic area HRRZ A,DIRORG(E) ; Get length of block ADDI A,-1(E) ; Last word of block IDIVI A,^D36 ; Separate bit and word MOVEM A,-1(P) ; Save word number MOVN C,BITS(B) ; Mask of bits up to and including last MOVE A,E IDIVI A,^D36 ; Separate first word into bit and word MOVE B,BITS(B) ; Get bit for beginning of block LSH B,1 ; Bit to left of desired bits SOS B ; Gives bits to right GCDI1: CAMN A,-1(P) ; Last word of bits? AND B,C ; Yes, reduce bits IORM B,@0(P) ; Or into bit word CAMN A,-1(P) ; Done? JRST GCDI0 ; Yes, next block SETO B, ; All ones for next word AOJA A,GCDI1 ; No ; Bit table is now formed, prepare for compaction GCDI2: MOVE A,FRETOP ADDI A,^D35 IDIVI A,^D36 ; End of bit table MOVEM A,-1(P) MOVEI A,DIFREE-DIRORG MOVEM A,-2(P) ; Current top of compacted storage SOS A ; Start scanning below good stuff MOVEM A,-3(P) ; In order to not miss anything GCDI3: MOVE A,-3(P) ; Get current loc IDIVI A,^D36 ; Separate MOVN B,BITS(B) ; Get mask of ones to ignore GCDI4: ANDCA B,@0(P) ; Get ones in bit table JFFO B,GCDI5 ; Find first one and jump CAMGE A,-1(P) ; No ones. end check AOJA A,GCDI4 ; Not end, try next. note b has 0 MOVE A,-2(P) ; Top of compacted storage MOVE B,FRETOP ; Top of dynamic area SUB B,A ; Recompute length of free area MOVEM B,DIRFRE+2 JUMPE B,[HRRZS DIRFRE ; Empty free list JRST GCDID] MOVEM B,DIRORG(A) HRLM A,DIRFRE GCDID: HRRZ A,0(P) ; Page address PUSHJ P,RELPAG ; Release SUB P,[XWD 5,5] ; Flush stack PUSHJ P,RESAC ; Restore ac's POPJ P, ; Found a one, now look for a zero GCDI5: MOVN B,BITS(B+1) ; Get mask of bits to left inc first 1 MOVEM B+1,-4(P) MOVE C,A IMULI C,^D36 ADDM C,-4(P) ; Location of first good word GCDI6: ANDCB B,@0(P) ; Get zeros, ignore those to left JFFO B,GCDI7 ; Find "zeroes" CAMGE A,-1(P) AOJA A,GCDI6 ; Try next word, note b=0 MOVEI B+1,^D36 GCDI7: IMULI A,^D36 ADD A,B+1 MOVEM A,-3(P) ; New bottom of garbage MOVE B,-2(P) ; Get "to" CAMN B,-4(P) ; Equals "from"? JRST GCDI9 ; Move not needed HRL B,-4(P) ; And "from" ADD B,[XWD DIRORG,DIRORG] SUB A,-4(P) ; Length of block ADDI A,(B) ; Compute end address BLT B,-1(A) ; Blt it ; State now is: ; -2(P) ; Top of previous compact storage ; -3(P) ; End of good block+1 ; -4(P) ; Beg of good block JSP D,GCSCAN ; Set up scan GCDI8: JSP D,0(D) ; Get a pointer JRST GCDI9 ; Done JFCL CAMGE E,-3(P) ; Beyond end CAMGE E,-4(P) ; Or before beg JRST GCDI8 ; Needs no adjustment ADD E,-2(P) ; Adjust by new bottom SUB E,-4(P) ; Minus old bottom JRST GCDI8 GCDI9: MOVE A,-3(P) ; End SUB A,-4(P) ; Minus beg = length ADDM A,-2(P) ; New top of compacted storage JRST GCDI3 ; Loop to find next good block ; The gc scanner ; This routine knows where all the good things are ; And operates as a coroutine with the garbage collector ; Started up with ; JSP D,GCSCAN ; For each datum, ; JSP D,(D) ; Returns ; +1 ; Nothing left ; +2 ; Possible pointer for updating ; +3 ; Pointer to good stuff to be retained ; Uses f,num,dev ; Returns datum in e GCSCAN: MOVE NUM,SYMBOT ; Start with first symbol table entry JSP D,(D) GCSCN1: CAML NUM,SYMTOP ; Entire table scanned? JRST GCSCN4 ; Yes. no skip return HLRZ E,DIRORG(NUM) ; Get pointer to string JSP D,2(D) HRLM E,DIRORG(NUM) ; Put back updated pointer HRRZ E,DIRORG(NUM) ; Get pointer to data block SKIPG DIRNUM JRST GCSCN5 TRZE E,700000 AOJA NUM,GCSCN1 ; No blocks for current uses of rh JSP D,2(D) HRRM E,DIRORG(NUM) GCSCN3: MOVE DEV,E ; Save root of fdb's GCSCN2: MOVE F,E ; Point to current fdb HRRZ E,FDBCTL+DIRORG(F) ; Pointer to name JSP D,2(D) HRRM E,FDBCTL+DIRORG(F) HLRZ E,FDBEXT+DIRORG(F) JSP D,2(D) HRLM E,FDBEXT+DIRORG(F) MOVE E,FDBACT+DIRORG(F) TLNN E,777777 JSP D,2(D) MOVEM E,FDBACT+DIRORG(F) HRRZ E,FDBVER+DIRORG(F) ; Pointer to next version JSP D,2(D) HRRM E,FDBVER+DIRORG(F) ; Update JUMPN E,GCSCN2 ; Scan all versions HRRZ E,FDBEXT+DIRORG(DEV) JSP D,2(D) ; Update HRRM E,FDBEXT+DIRORG(DEV) JUMPN E,GCSCN3 ; Scan all extensions AOJA NUM,GCSCN1 ; Scan all of the symtab GCSCN4: HRRZ E,DIRSAV JSP D,2(D) MOVEI E,-DIRORG(E) JSP D,2(D) MOVEI E,DIRORG(E) HRRM E,DIRSAV HRRZ E,DIRSCN JSP D,1(D) MOVEI E,-DIRORG(E) JSP D,1(D) MOVEI E,DIRORG(E) HRRM E,DIRSCN HRRZ E,DIRLOC JSP D,1(D) MOVEI E,-DIRORG(E) JSP D,1(D) MOVEI E,DIRORG(E) HRRM E,DIRLOC JRST (D) ; Subindex scanner GCSCN5: MOVE DEV,E ; Remember directory number SETZB E,F ; Zero mask and value PUSHJ P,CHGHSH ; Update hash entry bits masked 1 JSP D,2(D) ; Return pointer MOVSI F,7777 PUSHJ P,CHGHSH ; This really updates it MOVE DEV,E ; Remember pointer to ddb HLRZ E,DIRORG+DDBNAM(DEV) ; Pointer to password JSP D,2(D) HRLM E,DIRORG+DDBNAM(DEV) HRRZ E,DIRORG+DDBNAM(DEV) ; Pointer to name JSP D,2(D) HRRM E,DIRORG+DDBNAM(DEV) AOJA NUM,GCSCN1 CHGHSH: PUSH P,A ; Save temps PUSH P,B PUSH P,C PUSH P,DIRNUM ; Remember where to come back to MOVE A,DEV ; Get directory number to look up PUSHJ P,HSHLUK BUG(HLT,) HRLZS E XOR E,DIRORG(B) ; Get difference AND E,F ; Retain bits to change XORB E,DIRORG(B) ; Change bits, keep result HLRZS E ANDI E,7777 PUSHJ P,USTDIR POP P,A PUSHJ P,MAPDIR ; Return to proper subindex POP P,C ; Restore temps POP P,B POP P,A POPJ P, IFN 0,< ; Put item onto deallocation list ; Call: LH(A) ; Routine to call to deallocate the item ; RH(A) ; Item identifier (address usually) ; PUSHJ P,PUTITM ; Items put on the deallocation are automatically deallocated whenever ; A psi occurs and the user's program changes the pc such that ; The monitor routine in progress does not complete PUTITM::PUSH P,B ; Free up some ac's PUSH P,A PUTIT0: MOVE A,INTLVL ; Get current interrupt level SKIPE B,ITMHD(A) ; Get the correct item list header JRST PUTIT1 PUSH P,A ; No header, create one MOVEI A,PSBFRE MOVEI B,6 PUSHJ P,ASGPAG ; Assign a block of psb free storage JSR BUGHLT POP P,B MOVEM A,ITMHD(B) ; Point the header to the block HRLI A,1(B) HRRI A,2(B) SETZM 1(B) BLT A,6(B) ; Clear the block PUTIT1: HRLI B,5 AOS B ; Make aobjn pointer PUTIT2: SKIPN (B) ; Search for an empty slot JRST PUTIT3 ; Found AOBJN B,PUTIT2 MOVE B,INTLVL ; No empty slots MOVEI A,0 EXCH A,ITMHD(B) ; Clear header, get old header HRLI A,RELITB ; Make into an item word PUSHJ P,PUTITM ; Call self, making first thing on JRST PUTIT0 ; New block the old block. try again PUTIT3: POP P,A MOVEM A,(B) POP P,B POPJ P, ; Release all items on interrupt level specified in a ; Call: A ; Interrupt level ; PUSHJ P,RELITM RELITM::PUSH P,ITMHD(A) SETZM ITMHD(A) POP P,A JUMPN A,RELITB POPJ P, RELITB: PUSH P,A PUSH P,B HRLI A,-5 AOS A RELIT1: SKIPN B,(A) JRST RELIT2 PUSH P,A HRRZ A,B HRLZS B PUSHJ P,(B) POP P,A RELIT2: AOBJN A,RELIT1 MOVE B,-1(P) MOVEI A,PSBFRE PUSHJ P,RELFRE POP P,B POP P,A POPJ P, > ;STORAGE FOR RESIDENT FREE SPACE POOL .RESP1==:0 ;HIGHEST PRIORITY, ALWAYS TRY TO ASSIGN SPACE ;NO PAGE FAULTS ALLOWED .RESP2==:1 ;SECOND LEVEL, NO PAGE FAULTS ALLOWED ;BUT DONT ASSIGN SPACE IF BELOW RESMIN .RESP3==:2 ;PROCESS CONTEXT. PAGE FAULTS ALLOWED. ;LOCK DOWN MORE SPACE IF NECESSARY .RESGP==:0 ;GENERAL RESIDENT FREE SPACE POOL .RESTP==:1 ;TERMINAL POOL .RESNP==:2 ;NETWORK POOL .RSTMP==:3 ; TIMER pool RESQTL==:4 ;NUMBER OF POOLS OF RESIDENT FREE SPACE .RESGQ==:0 ;GENERAL QUOTA - USED BY PHYSIO FOR UDBS ; CDBS, KDBS, AND FOR SDBS. ; APPROXIMATELY 8 CHANNELS, 40 DRIVES, ; AND 16 ONLINE STRUCTURES .RESTQ==:0 ;NOT USED .RESEQ==:0 ;NOT USED .RESNQ==:14000 ;FOR CHAOSNET .RSTMQ==:0 ;NOT USED RESFRM==:<.RESNQ/3>/4 ;FOR NETWORK, NEED LOTS LOCKED DOWN RESFRA==:RESFRM*3 ;AVERAGE AMOUNT OF FREE SPACE LOCKED DOWN RESFRB==:RESFRA+^D25 ;SMALL INCREMENT OVER RESFRA FOR ; JOB 0 COMPLETION LS RESMIN,1 ;MINIMUM LEVEL FOR ALL BUT LEVEL 1 REQUESTS LS RESAVE,1 ;AVERAGE AMOUNT OF FREE SPACE LOCKED LS UPRSAV,1 ;LIMIT FOR JOB 0 ACTIVITY LS RESFRE,1 ;COUNT OF FREE BLOCKS LEFT LS RESFFB,1 ;FIRST FREE 4 WORD BLOCK LS RESIFL,1 ;INITIALIZATION FLAG = -1 DURING STARTUP NRESFP==:2*<.RESGQ+.RESTQ+.RESNQ+.RSTMQ>/3000 ;# OF PAGES IS 2/3 OF SUM OF QUOTAS NRESFB==:NRESFP*PGSIZ/4 ;NUMBER OF RESIDENT FREE 4 WORD BLOCKS ;NRP RESFRP, ;RESERVE SPACE FOR RESIDENT FREE POOL LS RESFRP,<*PGSIZ> ;MICROCODE CANNOT HANDLE UNMAPPED PACKETS ;ALSO THERE SEEMS TO BE A BUG THAT AGES LOCKED ;PAGES AND CAUSES PAGE FAULTS ON THEM RESFRZ==:RESFRP+-1 ;END OF RESIDENT FREE POOL RESBTL==:/^D36 ;LENGTH OF BIT TABLE LS RESBTB,RESBTL ;RESIDENT FREE SPACE BIT TABLE LS RESBAS,1 ;BASE ADDRESS OF THE RESIDENT FREE POOL LS RESUTB,RESQTL ;RESIDENT FREE SPACE USAGE TABLE ;ROUTINE TO ASSIGN RESIDENT FREE SPACE ;ACCEPTS IN T1/ PRI ,, LEN ; T2/ FLAGS ,, POOL # ; CALL ASGRES ;RETURNS +1: FAILED TO GET THE REQUESTED SPACE ; T1/ ERROR CODE ; +2: ADDRESS OF BLOCK IN T1 RESCD ASGRES::ASUBR HRRZI T1,4(T1) ;CONVERT TO THE # OF 4 WORD BLOCKS ASH T1,-2 ; PLUS 1 WORD FOR THE LENGTH MOVEM T1,ASGREC ;SAVE THE COUNT OF BLOCKS NEEDED HRRZ T2,ASGREF ;GET POOL NUMBER CAIL T2,RESQTL ;IS THIS A LEGAL NUMBER? JRST ASGREQ CAML T1,RESUTB(T2) ;IS THERE ENOUGH IN THE POOL? RETBAD (MONX01) ;NO. RETURN 'NO RESIDENT FREE SPACE' ;THERE IS ENOUGH SPACE IN THE REQUESTED POOL. IF GIVING THIS SPACE ;AWAY WILL PUT US UNDER A UM, WE MAY WANT TO EXPAND THE POOL. ASGRE0: MOVE T2,RESFRE ;GET AMOUNT OF SPACE LEFT SUB T2,ASGREC ;DECREMENT BY THE REQUESTED AMOUNT HLRZ T3,ASGREA ;GET PRIORITY CAILE T3,.RESP3 ;LEGAL VALUE? JRST ASGREP CAMGE T2,RESMIN ;WOULD THIS PUT US UNDER THE MINIMUM? JRST [ CAIE T3,.RESP1 ;HIGHEST PRIORITY? JRST ASGRE1 ;NO, GO TRY TO EXPAND THE FREE POOL JRST .+1] ;YES, GO TRY TO GET SPACE ANYWAY ;EITHER REQUEST IS OF HIGHEST PRIORITY OR THERE IS SUFFICIENT ;SPACE MOVE T1,ASGREC ;GET NUMBER OF BLOCKS DESIRED MOVEI T2,RESBTB ;GET START OF BITTABLE MOVEI T3,RESBTL ;AND THE LENGTH OF THE BITTABLE CALL GETBIT ;GET AND SET THIS NUMBER OF BITS JRST ASGRE1 ;COULD NOT GET IT, GO TRY TO EXPAND MOVN T2,ASGREC ;GET NUMBER OF BLOCKS REQUESTED HRRZ T3,ASGREF ;GET POOL NUMBER ADDM T2,RESUTB(T3) ;DECREMENT THE USAGE COUNT ADDB T2,RESFRE ;DECREMENT THE COUNT MOVE T3,RESFFB ;GET FIRST FREE BLOCK CAMGE T2,RESAVE ;BELOW THE AVERAGE DESIRED? CAIL T3,NRESFB ;YES, ANY BLOCKS LEFT? SKIPA ;NO, DO NOT WAKE UP JOB 0 AOS JB0FLG## ;YES, WAKE UP JOB 0 TO EXPAND FREE POOL LSH T1,2 ;GET THE OFFSET IN THE FREE SPACE ADD T1,RESBAS ;ADD IN THE BASE ADDRESS OF FREE SPACE ;SET UP THE HEADER WORD (THE WORD PRECEDING THE START OF THE ;BLOCK AS RETURNED TO THE USER). ZERO THE BLOCK OF FREE SPACE MOVE T2,ASGREC ;GET THE NUMBER OF BLOCKS ASSIGNED HRL T2,ASGREF ;GET POOL # OF ASSIGNMENT MOVEM T2,(T1) ;SAVE THIS IN THE HEADER WORD AOS T1 ;RETURN POINTER TO FIRST FREE WORD SETZM 0(T1) ;ZERO THE FIRST WORD OF THE BLOCK LSH T2,2 ;NOW ZERO THE BLOCK HRL T3,T1 ;START AT FIRST WORD HRRI T3,1(T1) ;WORD +1 ADD T2,T1 ;GET POINTER TO END OF BLOCK (+1) HRRZS T2 ;STAY IN SAME SECTION BLT T3,-2(T2) ;ZERO THE BLOCK RETSKP ;AND GIVE THE SUCCESSFUL RETURN ;HERE WHEN THE FREE SPACE NEEDS TO BE EXPANDED. DO IT, AND THEN ;GO TRY AGAIN TO SATISFY USER'S REQUEST ASGRE1: HLRZ T1,ASGREA ;GET THE PRIORITY CALL GRORES ;TRY TO EXPAND THE FREE POOL RETBAD () ;COULDNT GET ANY MORE JRST ASGRE0 ;GOT SOME, GO SEE IF THIS WAS ENOUGH ASGREQ: BUG(CHK,) RETBAD (MONX01) ;RETURN 'MONITOR INTERNAL ERROR' ASGREP: BUG(CHK,) RETBAD(MONX01) ;RETURN 'MONITOR INTERNAL ERROR' ;ROUTINE TO EXPAND THE RESIDENT FREE POOL ;ACCEPTS IN T1/ PRIORITY NUMBER (.RESP1, .RESP2, OR .RESP3) ; CALL GRORES ;RETURNS +1: COULD NOT GET ANY ; T1/ ERROR CODE ; +2: FOUND SOME GRORES: STKVAR <> CAIE T1,.RESP3 ;IN PROCESS CONTEXT? SKIPE RESIFL ;OR, IS THIS DURING SYSTEM START UP? JRST GRORE1 ;YES, PAGES CAN BE LOCKED DOWN PIOFF ;ENTER TOUCHY CODE MOVE T1,RESFFB ;GET FIRST FREE BLOCK TRNE T1,177 ;IS THERE ANY LEFT ON THIS PAGE? CAIL T1,NRESFB ;OR ANY LEFT IN ENTIRE POOL? JRST [ PION ;NO, GIVE ERROR RETURN RETBAD (MONX01)] ;RETURN 'NO FREE SPACE' MOVEI T2,200(T1) ;YES, GRAB THIS BLOCK TRZ T2,177 ;GET POINTER TO NEXT FREE BLOCK MOVEM T2,RESFFB ;STORE NEW POINTER PION JRST GRORE2 ;GO RETURN THIS BLOCK GRORE1: PIOFF ;GET A FULL PAGE (IF NECESSARY) MOVE T1,RESFFB ;GET FIRST FREE BLOCK CAIL T1,NRESFB ;ANY LEFT? JRST [ PION ;NO RETBAD(MONX01)] ;RETURN 'NO FREE SPACE' MOVEI T2,200(T1) ;GET THIS PAGE (OR PARTIAL BLOCK) TRZ T2,177 MOVEM T2,RESFFB ;STORE NEW POINTER PION DMOVEM T1,GRORET ;STORE THE BLOCK NUMBER LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK ADD T1,RESBAS REPEAT 0,< CALL FPTA ;LOCK IT DOWN CALL MLKPG## ;... >;SINCE ALL RESIDENT NOW DMOVE T1,GRORET ;GET BLOCK NUMBER BACK AGAIN GRORE2: SUB T2,T1 ;GET THE SIZE OF THIS BLOCK LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK ADD T1,RESBAS ;... HRRZM T2,(T1) ;STORE SIZE OF THE BLOCK MOVNS T2 ;FUDGE THE USE COUNT ADDM T2,RESUTB ;FOR THE GENERAL POOL AOS T1 ;GET POINTER TO BLOCK FOR RELRES CALL RELRES ;RELEASE THIS BLOCK TO THE FREE POOL RETSKP ;AND GIVE SUCCESS RETURN ;ROUTINE TO FIND AND MARK A BLOCK OF CONSECUTIVE FREE BITS IN A TABLE ;ACCEPTS IN T1/ NUMBER OF BITS NEEDED ; T2/ ADDRESS OF START OF BITTABLE ; T3/ LENGTH OF THE BITTABLE ; CALL GETBIT ;RETURNS +1: NOT ENOUGH AVAILABLE ; T1/ ERROR CODE ; +2: T1/ RELATIVE OFFSET OF FIRST BIT OBTAINED GETBIT: SAVEP ;SAVE SOME WORK ACS ASUBR GETBI1: MOVE P1,GETBIA ;SET UP FOR GETZ - P1=ADR OF BIT TABLE MOVE P2,GETBIL ;P2=LENGTH OF BIT TABLE MOVE P3,GETBIC ;P3=COUNT OF BITS NEEDED CALL GETZ ;GET THE BITS RETBAD (MONX01) ;NONE FOUND CALL SETOS ;MARK THEM AS TAKEN, IF STILL AVAILABLE JRST GETBI1 ;OPPS, GRABBED AT INTERRUPT LEVEL HRRZ T1,P4 ;GOT IT, GET ADR OF FIRST WORD WITH 0'S SUB T1,GETBIA ;GET RELATIVE POSITION IN TABLE IMULI T1,^D36 ;GET BIT POSITION IN TABLE MOVN T2,P5 ;GET BIT POSITION IN WORD ADDI T1,^D36(T2) ;NOW HAVE RELATIVE POSITION RETSKP ;GIVE SUCCESSFUL RETURN ;CO-ROUTINE FOR GETBIT TO FIND N CONSECUTIVE 0'S IN A TABLE ;ACCEPTS IN P1/ ADDRESS OF TABLE ; P2/ LENGTH OF TABLE ; P3/ NUMBER OF BITS NEEDED ; CALL GETZ ;RETURNS +1: NONE FOUND ; T1/ ERROR CODE ; +2: P1-P3 UNCHANGED ; P4 LOC OF WORD IN TABLE OF FIRST 0 BIT ; P5 BIT NUMBER WITHIN WORD OF FIRST 0 BIT ; WHERE POSTION=36 IF BIT 0, 1 IF BIT 35 GETZ: MOVEI T4,^D36 ;SET UP LOCAL COUNT WITHIN WORD SETCM T1,(P1) ;GET WORD TO INVESTIGATE JUMPE T1,GETZ4 ;FULL IF 0 JUMPG T1,GETZ3 ;1ST BIT UNAVAILABLE IF POSITIVE GETZ1: SETCA T1, ;SET BACK TO REAL CONTENTS JFFO T1,GETZR ;COUNT THE NUMBER OF 0'S MOVEI T2,^D36 ;36 OF THEM GETZR: MOVE T3,T2 ;SHIFT COUNT MOVEM P1,P4 ;SAVE POSITION IN P4 MOVEM T4,P5 ;SAVE COUNT WITHIN WORD TOO GETZ2: CAIL T3,(P3) ;FOUND ENOUGH? RETSKP ;YES, THEN DONE SUBI T4,(T2) ;NO, DECREASE POSITION COUNTER JUMPLE T4,GETZ5 ;ARE THERE 0'S ON END? SETCA T1, ;NO, NOW WE WANT TO COUNT 1'S LSH T1,1(T2) ;REMOVE BIT ALREADY LOOKED AT JUMPE T1,GETZ4 ;GO IF THE REST OF THE WORD IS ALL 1'S GETZ3: JFFO T1,.+1 ;GET NUMBER OF REAL 1'S LSH T1,(T2) ;GET RID OF THEM CAIN T4,^D36 ;FIRST POSITION IN WORD? ADDI T4,1 ;YES, SUBTRACT REAL JFFO COUNT SUBI T4,1(T2) ;DECREASE POSITION COUNT JUMPG T4,GETZ1 ;TRY NEXT 0, IF ANY MORE GETZ4: AOS P1 ;NO MORE, STEP TO NEXT WORD SOJG P2,GETZ ;LOOP BACK IF THERE ARE ANY MORE WORDS GETZE: RETBAD (MONX01) ;NO MORE ;HERE IF THE DESIRED SIZE NOT YET FOUND, BUT A WORD HAD 0'S ON THE END GETZ5: AOS P1 ;STEP TO NEXT WORD SOJLE P2,GETZE ;IF NO MORE, THEN ERROR SKIPGE T1,(P1) ;NEXT WORD POSITIVE? JRST GETZ ;NO, THIS HOLE IS NOT BIG ENOUGH JFFO T1,GETZ6 ;YES, COUNT THESE 0'S MOVEI T2,^D36 ;36 OF THEM GETZ6: ADDI T3,(T2) ;ADD THEM INTO THE RUNNING TOTAL MOVEI T4,^D36 ;RESET POSITION COUNT JRST GETZ2 ;AND TEST THIS HOLE ;CO-ROUTINE TO GETBIT TO MARK A BLOCK OF BITS AS "IN USE" ;ACCEPTS IN P3/ HOW MANY BITS IN BLOCK ; P4/ POINTER TO WORD CONTAINING FIRST 0 ; P5/ POSITION OF FIRST 0 ; CALL SETOS ;RETURNS +1: BITS WERE ALREADY IN USE ; +2: BITS SUCCESSFULLY MARKED AS "IN USE" SETOS: MOVE T4,P4 ;WHERE HRRZ T3,P3 ;COUNT MOVE T1,P5 ;POSITION IN WORD CALL BITMSK ;GENERATE A BIT MASK SETOS1: PIOFF ;PREVENT INTERRUPTIONS FROM ABOVE TDNE T1,(T4) ;BIT ALREADY ON? JRST SETOS2 ;YES, GO CLEAN UP AND EXIT IORM T1,(T4) ;NO, NOW MARK THESE AS IN USE PION ;THROUGH THE TOUCHY PART FOR NOW JUMPLE T3,RSKP ;ALL DONE? CALL BITMS2 ;NO, CONTINUE WITH NEXT WORD IN BLOCK JRST SETOS1 ;BIT MASK OBTAINED, GO MARK THE BITS SETOS2: PION ;BIT ALREADY IN USE, MUST UNDO OTHERS PUSH P,T3 ;SAVE CURRENT COUNT AS A STOPPING POINT MOVE T4,P4 ;GET START OF BLOCK AGAIN HRRZ T3,P3 ;AND ORIGINAL COUNT MOVE T1,P5 ;AND POSITION OF FIRST 0 BIT CALL BITMSK ;GET A BIT MASK SETOS3: CAMN T3,(P) ;ARE WE UP TO POINT OF LOSSAGE? JRST SETOS4 ;YES ANDCAM T1,(T4) ;NO, CLEAR THESE BITS CALL BITMS2 ;CONTINUE THROUGH THE BLOCK JRST SETOS3 ;LOOP BACK UNTIL ALL CLEANED UP SETOS4: POP P,(P) ;CLEAN UP STACK RET ;AND GIVE NON-SKIP RETURN ;ROUTINE TO RETURN RESIDENT FREE SPACE TO THE FREE POOL ;ACCEPTS IN T1/ ADDRESS OF THE BLOCK ; CALL RELRES ;RETURNS +1: ALWAYS RELRES::STKVAR ;209 MOVEM T1,RLRSAD ;209 Stash away the argument SOS T2,T1 ;GET THE ADDRESS OF THE START OF THE BLOCK MOVE T1,(T2) ;GET THE NUMBER OF BLOCKS IN THIS BLOCK SUB T2,RESBAS ;GET THE OFFSET INTO THE FREE POOL TRNE T1,-1 ;ZERO LENGTH BLOCK? TDNE T2,[-1,,3] ;THIS MUST START ON A 4 WORD BOUNDRY IN POOL JRST RESBAD LSH T2,-2 ;GET 4 WORD BLOCK NUMBER IDIVI T2,^D36 ;GET POSITION OF BLOCK WITHIN BIT TABLE HRRZ T4,T1 ;SEE IF THIS BLOCK IS WITHIN THE POOL ADD T4,T2 ;GET END OF BLOCK CAIL T4,NRESFB ;IS THIS WITHIN THE BIT TABLE LIMITS JRST RESBND HLRZ T4,T1 ;GET POOL NUMBER HRL T1,T4 ;209 SAVE AWAY POOL,,SIZE MOVEM T1,RLRADJ ;209 FOR LATER HRRZS T1 ;GET THE SIZE OF THE BLOCK ;209 ADDM T1,RESUTB(T4) ;ADD BACK THE SPACE FREED TO USAGE TABLE ;209 ADDM T1,RESFRE ;COUNT UP THE FREE COUNT MOVEI T4,RESBTB(T2) ;GET ADR OF FIRST WORD OF BLOCK EXCH T3,T1 ;SET UP FOR CALL TO CLRBTS MOVEI T2,^D36 ;GET BIT POSITION IN CORRECT FORMAT SUBM T2,T1 ; FOR CLRBTS CALL CLRBTS ;FREE UP THIS SPACE JRST RESBAZ HRRZ T1,RLRADJ ;209 NOW ADJUST FOR THE FREEAGE HLRZ T4,RLRADJ ;209 ADDM T1,RESUTB(T4) ;209 ADDM T1,RESFRE ;209 RET ;EXIT RESBAD: BUG(CHK,) RET RESBAZ: BUG(CHK,) RET RESBND: BUG(CHK,) RET ;YES, JUST EXIT ;ROUTINE TO CLEAR BITS IN A BIT TABLE ;ACCEPTS IN T1/ POSITION WITHIN WORD OF FIRST 0 (36=BIT 0, 1=BIT 35) ; T3/ COUNT OF THE NUMBER OF BITS TO BE CLEARED ; T4/ ADDRESS OF FIRST WORD CONTAINING THE BLOCK OF BITS ; CALL CLRBTS ;RETURNS +1: SOME OF THE BITS WERE ALREADY ZERO ; +2: SUCCESSFUL CLRBTS: CALL BITMSK ;GENERATE A BIT MASK FOR THE FIRST WORD CLRBT1: PIOFF ;ENTER INTERLOCKED CODE MOVE T2,(T4) ;GET THE WORD TO BE CLEARED TDC T2,T1 ;SEE IF ANY OF THE BITS ARE ALREADY 0 TDNE T2,T1 ;... JRST [ PION ;BITS ARE ALREADY 0 RET] ;GIVE FAILURE RETURN WITHOUT DOING MORE ANDCAM T1,(T4) ;CLEAR THE BITS PION ;THROUGH INTERLOCKED CODE JUMPLE T3,RSKP ;ANY MORE TO BE CLEARED? CALL BITMS2 ;YES, GET NEXT BIT MASK JRST CLRBT1 ;LOOP BACK FOR REST OF BITS ;ROUTINE TO BUILD A BIT MASK FOR N BITS WITHIN A WORD ;ACCEPTS IN T1/ POSITION OF FIRST BIT (36=BIT 0, 1=BIT 35) ; T3/ COUNT OF BITS IN MASK ; T4/ POSITION IN BIT TABLE OF THIS WORD ; CALL BITMSK ;RETURNS +1: T1/ MASK ; T3/ REMAINING COUNT (T3 .LE. 0 MEANS DONE) ; T4/ UPDATED TO POINT TO NEXT WORD IN TABLE (BITMS2) BITMSK: PUSH P,T1 ;SAVE POSITION MOVN T1,T3 ;GET NEGATIVE COUNT CAILE T3,^D36 ;MORE THAN 1 WORD? MOVNI T1,^D36 ;YES, SETTLE FOR ONE WORD (OR LESS) MOVSI T2,400000 ;SET UP TO PROPAGATE A MASK ASH T2,1(T1) ;GET THE RIGHT NUMBER OF BITS IN MASK SETZ T1, ;CLEAR ANSWER AC LSHC T1,@0(P) ;POSITION THE BITS PROPERLY IN T1 SUB T3,0(P) ;REDUCE THE COUNT TO THE NEW VALUE POP P,(P) ;CLEAN UP THE STACK RET ;AND EXIT WITH MASK IN T1 ;SECONDARY ROUTINE FOR BIT MASK GENERATION. START WITH BIT 0. ;SAME OPERATION AS BITMSK EXCEPT THAT T4 IS INCREMENTED ON EXIT BITMS2: SETO T1, ;MASK STARTS AT BIT 0 MOVNI T2,-^D36(T3) ;SET UP SHIFT CAIGE T3,^D36 ;DONT SHIFT IF MORE THAN ONE WORD LSH T1,(T2) ;POSITION THE MASK SUBI T3,^D36 ;UPDATE THE COUNT AOJA T4,R ;UPDATE TABLE ADDRESS AND RETURN ;INITIALIZATION ROUTINE FOR THE RESIDENT FREE POOL RESFPI::MOVEI T1,RESBTL ;GET LENGTH OF THE RESIDENT BIT TABLE RESFP1: SETOM RESBTB-1(T1) ;MARK ALL BITS AS "IN USE" SOJG T1,RESFP1 ;LOOP FOR ALL WORDS IN THE BIT TABLE MOVE T1,[RESFRP] ;GET ADDRESS OF START OF FREE POOL ADDI T1,777 ANDI T1,777000 ;BUMP TO PAGE START MOVEM T1,RESBAS SETZM RESFFB ;FIRST FREE BLOCK IS BLOCK # 0 SETZM RESFRE ;NO FREE SPACE YET MOVEI T1,RESFRM ;GET INITIAL VALUE OF MINIMUM MOVEM T1,RESMIN MOVEI T1,RESFRA ;SET UP THE AVERAGE LEVEL MOVEM T1,RESAVE ;THIS LEVEL IS MAINTAINED BY JOB 0 MOVEI T1,RESFRB ;GET JOB 0 THRESHOLD VALUE MOVEM T1,UPRSAV ;ESTABLISH LIMIT MOVSI T1,-RESQTL ;NOW SET UP THE USAGE TABLE RESFP2: MOVE T2,RESQTB(T1) ;GET QUOTA MOVEM T2,RESUTB(T1) ;SAVE AS USAGE AOBJN T1,RESFP2 ;LOOP TIL TABLE INITIALIZED RET ;ALL SET UP RESQTB: .RESGQ/4 ;GENERAL POOL QUOTA .RESTQ/4 ;TERMINAL POOL QUOTA .RESNQ/4 ;NETWORK POOL QUOTA .RSTMQ/4 ;TIMER POOL QUOTA RESQTL==:.-RESQTB ;THIS VALUE MUST MATCH THE ONE IN STG ;ROUTINE CALLED BY JOB 0 TO LOCK AND UNLOCK FREE SPACE ; CALL RESLCK ;RETURNS +1: ALWAYS SWAPCD RESLCK::MOVE T1,UPRSAV ;SEE HOW CLOSE TO THE AVERAGE WE ARE CAMG T1,RESFRE ;DO WE HAVE ENOUGH LOCKED DOWN? JRST RESLK1 ;YES, GO SEE IF SOME NEEDS UNLOCKING MOVEI T1,.RESP3 ;NEED MORE, GO GET SOME CALL GRORES ;AT PROCESS LEVEL SO PAGE FAULTS ALLOWED RET ;COULD NOT GET ANY, JUST RETURN JRST RESLCK ;GO SEE IF THIS WAS ENOUGH RESLK1: MOVE T1,RESFRE ;NOW CHECK IF SOME NEEDS UNLOCKING CAMG T1,UPRSAV ;ARE WE ABOVE THE AVERAGE? RET ;NO, THEN EXIT MOVE T3,RESFFB ;YES, TRY TO UNLOCK SOME MOVE T1,T3 ;REMEMBER THE FIRST FREE BLOCK IN T3 IDIVI T1,^D36 ;BUILD A BYTE POINTER TO FIRST BIT MOVNS T2 ;GET BIT NUMBER IN WORD SKIPN T2 ;IS THIS THE FIRST BIT IN A WORD SOSA T1 ;YES, BACK UP TO LAST BIT OF PREVIOUS WORD ADDI T2,^D36 ;GET BIT POSITION WITHIN WORD ROT T2,-6 ;USE THIS AS THE BIT POSITION TLO T2,0100+T1 ;ONE BIT BYTE POINTER INDEXED BY T1 ADDI T1,RESBTB ;GET OFFSET INTO BIT TABLE JRST RESLK3 ;GO TO RESMON FOR CRITICAL CODE ;RESIDENT CODE TO DO NON-PI FUNCTIONS RESCD RESLK3: NOSKED PIOFF ;MUST BE DONE INTERLOCKED CAME T3,RESFFB ;STILL HAVE SAME FIRST FREE BLOCK? JRST [ PION ;NO, GO TRY AGAIN OKSKED JRST RESLK1] LDB T4,T2 ;GET THE BIT JUMPN T4,[PION ;IF = 1, THEN IN USE SOMEWHERE OKSKED RET] ;SO RETURN MOVEI T4,1 ;NOT IN USE, MARK IT TAKEN DPB T4,T2 ;... SOS RESFRE ;COUNT DOWN THE FREE COUNT SOS T1,RESFFB ;AND REMOVE IT FROM FREE POOL PION ;THROUGH INTERLOCKED CODE JRST RESLK4 ;NOW, BACK TO SWPMON ;RETURN TO SWAPPABLE CODE FOR PI FUNCTIONS SWAPCD RESLK4: LSH T1,2 ;GET THE ADDRESS OF THIS BLOCK ADD T1,RESBAS ;... TRNE T1,777 ;IS THIS ON A PAGE BOUNDRY? JRST RESLK2 ;NO, CANNOT UNLOCK THIS PAGE CALL FPTA## ;YES, THIS PAGE CAN NOW BE UNLOCKED CALL MULKPG## ;UNLOCK IT RESLK2: OKSKED JRST RESLK1 ;GO SEE IF MORE WORK NEEDED ;ROUTINE TO ASSIGN SPACE FROM THE FREE POOL SWFREL==:400 SWOPTL==:10 NR(SWPFRE,7) ;FREE SPACE HEADER BLOCK NR(SWFREE,SWFREL) ;FREE STORAGE SPACE FOR MESSAGES ;AND HEADERS ;INITIALIZE SWPFRE SWPINI::MOVE T1,[SWFREE,,SWFREE+1] SETZM SWFREE ;ZERO THE FREE POOL BLT T1,SWFREE+SWFREL-1 ;... MOVEI T1,SWFREE ;GET ADR OF FREE POOL HRLOM T1,SWPFRE ;INITIALIZE POINTER TO FREE BLOCK MOVEI T1,SWFREL ;GET LENGTH OF FREE AREA HRRZM T1,SWFREE ;MAKE IT ONE LARGE BLOCK MOVEM T1,SWPFRE+2 ;STORE IN SPACE COUNTER SETOM SWPFRE+1 ;INITIALIZE LOCK ON FREE STORE MOVE T1,[XWD SWFREE+SWFREL,SWFREE] MOVEM T1,SWPFRE+4 ;SET UP TOP AND BOTTOM POINTERS MOVEI T1,SWOPTL ;GET OPTIMUM LENGTH OF MESSAGES MOVEM T1,SWPFRE+3 ;SAVE IN HEADER BLOCK RET ;ACCEPTS IN T1: DESIRED BLOCK SIZE ; CALL ASGSWP ;RETURNS +1: NOT ENOUGH ROOM, ERROR CODE IN T1 ; +2: BLOCK ASSIGNED ; T1/ POINTER TO ASSIGNED BLOCK ASGSWP::MOVE T2,T1 ;GET SIZE IN T2 FOR CALL TO ASGFRE MOVEI T1,SWPFRE ;GET POINTER TO FREE SPACE HEADER CALL ASGFRE ;GET THE SPACE RETBAD (IPCFX8) ;NOT ENOUGH ROOM HRRZS T2,0(T1) ;INITIALIZE SPACE TO 0'S CAIG T2,1 ;MORE THAN 1 WORD? JRST ASGSW0 ;NO. DONE SETZM 1(T1) ;YES, CLEAR FIRST WORD AFTER LENGTH HRLI T3,1(T1) ;SET UP A BLT POINTER HRRI T3,2(T1) ;... MOVEI T4,0(T1) ;GET POINTER TO BLOCK ADDI T4,0(T2) ;GET POINTER TO END OF BLOCK + 1 CAILE T2,2 ;IS BLOCK LESS THAN 3 WORDS LONG? BLT T3,-1(T4) ;NO, ZERO BLOCK (BUT NOT LENGTH WORD) ASGSW0: RETSKP ;ROUTINE TO RELEASE A BLOCK TO THE FREE POOL ;ACCEPTS IN T1/ ADR OF BLOCK TO BE RELEASED ; T2/ LENGTH OF BLOCK ; CALL RELSWP ;RETURNS +1: ALWAYS - BLOCK RELEASED ; OR ;ACCEPTS IN T1: ADDRESS OF BLOCK TO BE RELEASED ; CALL RELMES ;RETURNS +1: ALWAYS - BLOCK RELEASED RELSWP::HRRZM T2,0(T1) ;GLOBAL CALL WITH LENGTH IN T2 JUMPLE T2,RELFRM RELMES::MOVE T2,T1 ;SET UP FOR CALL TO RELFRE MOVEI T1,SWPFRE ;GET ADR OF FREE LIST HEADER HRRZS 0(T2) ;CLEAR LEFT HALF OF BLOCK SIZE WORD CALLRET RELFRE ;RELEASE THE BLOCK AND RETURN RELFRM: BUG(CHK,) END